﻿<%
'''Json对象类
Class JsonClass
	
	'Json收集器,个数,是否使用引号,类型,是否编码中文,是否安全编码
	Public Collection, Count, QuotedVars, Kind, StrEncode, Encode
	
	'''构造
	Private Sub Class_Initialize()
		Set Collection = CreateObject(C_DicName)
		If TypeName(Json) = "JsonClass" Then
			QuotedVars = Json.QuotedVars
			StrEncode = Json.StrEncode
		Else
			QuotedVars = True
			StrEncode = False
			Encode = False
		End If
		Count = 0
	End Sub
	
	'''析构
	Private Sub Class_Terminate()
		Set Collection = Nothing
	End Sub
	
	'''新建Json对象
	'p_k:Json对象的类型
	Public Function [New](Byval p_k)
		Set [New] = New JsonClass
		Select Case LCase(p_k)
		Case "0", "object"
			[New].Kind = 0
		Case "1", "array"
			[New].Kind = 1
		End Select
	End Function
	
	'''获取当前个数,并在之后+1
	Private Property Get counter_()
		counter_ = Count
		Count = Count + 1
	End Property
	
	'''设置Json对象中的对值
	'p_p:键名
	'p_v:键值
	Public Property Let Pair(Byval p_p, Byval p_v)
		If IsNull(p_p) Then
			p_p = counter_
		End If
		If VarType(p_v) = 9 Then
			If TypeName(p_v) = "JsonClass" Then
				Set Collection(p_p) = p_v
			Else
				Collection(p_p) = p_v
			End If
		Else
			Collection(p_p) = p_v
		End If
	End Property
	
	'''获取Json对象中的对值
	'默认动作
	'p_p:键名
	Public Default Property Get Pair(Byval p_p)
		If IsNull(p_p) Then
			p_p = Count - 1
		End If
		If IsObject(Collection(p_p)) Then
			Set Pair = Collection(p_p)
		Else
			Pair = Collection(p_p)
		End If
	End Property
	
	'''删除Json对象的全部对值
	Public Sub Clean()
		Collection.RemoveAll
	End Sub
	
	'''删除Json对值中的一项
	'p_p:键名
	Public Sub Remove(Byval p_p)
		Collection.Remove(p_p)
	End Sub
	
	'''转换字符串为安全的JavaScript字符串(不转换中文字符)
	'p_s:要转化的字符串
	Private Function jsEncode_(Byval p_s)
		If IsN(p_s) Then
			jsEncode_ = "" : Exit Function
		End If
		Dim t_a1, t_a2, t_i, t_j, t_c, t_p, t_t
		t_a1 = Array(&h27,&h22,&h5C,&h2F,&h08,&h0C,&h0A,&h0D,&h09)
		t_a2 = Array(&h27,&h22,&h5C,&h2F,&h62,&h66,&h6E,&h72,&h749)
		For t_i = 1 To Len(p_s)
			t_p = True
			t_c = Mid(p_s, t_i, 1)
			For t_j = 0 To Ubound(t_a1)
				If t_c = Chr(t_a1(t_j)) Then
					t_t = t_t & "\" & Chr(t_a2(t_j))
					t_p = False
					Exit For
				End If
			Next
			If t_p Then
				t_t = t_t & t_c
			End If
		Next
		jsEncode_ = t_t
	End Function
	
	'''还原成数组(似乎可以优化)
	Private Function renderArray_(Byval p_a, Byval p_d, Byval p_p)
		Dim t_f : t_f = LBound(p_a, p_d)
		Dim t_l : t_l = UBound(p_a, p_d)
		Dim t_i, t_r
		Dim t_t : t_t = ","
		renderArray_ = "["
		For t_i = t_f To t_l
			If t_i = t_l Then
				t_t = ""
			End If 
			On Error Resume Next
			t_r = renderArray_(p_a, p_d + 1, p_p & t_i & "," )
			If Err = 9 Then
				On Error GoTo 0
				renderArray_ = renderArray_ & ToJson(Eval("p_a(" & p_p & t_i & ")")) & t_t
			Else
				renderArray_ = renderArray_ & t_r & "" & t_t
			End If
		Next
		renderArray_ = renderArray_ & "]"
	End Function
	
	'''将目标转化为Json对值中的值
	'p_v:JsonClass对象
	Public Function ToJson(Byval p_v)
		Select Case VarType(p_v)
		Case 1
			ToJson = "null"
		Case 7
			ToJson = """" & CStr(p_v) & """"
		Case 8
			ToJson = """" & IIF(Encode, IIF(StrEncode, JsEncode(p_v),jsEncode_(p_v)), p_v) & """"
		Case 9
			Dim t_b, t_i 
			t_b = True
			ToJson = ToJson & IIF(p_v.Kind, "[", "{")
			For Each t_i In p_v.Collection
				If t_b Then
					t_b = False
				Else
					ToJson = ToJson & ","
				End If
				ToJson = ToJson & IfThen(p_v.Kind=0, IIF(QuotedVars, """" & t_i & """", t_i) & ":") & ToJson(p_v(t_i))
			Next
			ToJson = ToJson & IIF(p_v.Kind, "]", "}")
		Case 11
			ToJson = IIF(p_v, "true", "false")
		Case 12, 8192, 8204
			ToJson = renderArray_(p_v, 1, "")
		Case Else
			ToJson = Replace(p_v, ",", ".")
		End Select
	End Function
	
	'''将当前Json对象生成Json字符串
	Public Property Get JsString()
		JsString = ToJson(Me)
	End Property
	
	'''禁止页面缓存
	Private Sub addHeader_()
		Response.Clear()
		Response.Charset = "UTF-8"
		Response.ContentType = "application/json"
		Response.Buffer = True
		Response.Expires = 0
		Response.ExpiresAbsolute = Now() - 1
		Response.CacheControl = "no-cache"
		Response.AddHeader "Expires",Date()
		Response.AddHeader "Pragma","no-cache"
		Response.AddHeader "Cache-Control","private, no-cache, must-revalidate"
	End Sub
	
	'''输出当前Json对象
	Public Sub Flush()
		addHeader_()
		Response.Write(JsString)
	End Sub
	
	'''复制Json对象
	'p_c:JsonClass对象
	Private Function colClone_(Byval p_c)
		Dim t_j, t_i
		Set t_j = New JsonClass
		t_j.Kind = p_c.Kind
		For Each t_i In p_c.Collection
			If IsObject(p_c(t_i)) Then
				Set t_j(t_i) = colClone_(p_c(t_i))
			Else
				t_j(t_i) = p_c(t_i)
			End If
		Next
		Set colClone_ = t_j
	End Function
	
	'''复制当前Json对象为新的Json对象
	Public Function Clone()
		Set Clone = colClone_(Me)
	End Function
	
	'''判断json对象是否含有某键值
	'p_p:键值名
	Public Function Exists(Byval p_p)
		Exists = Collection.Exists(p_p)
	End Function
	
	'''将IDPID转为数结构/未完成
	Public Function ToTree(Byval p_id, Byval p_pid, ByVal p_sign)
		Dim t_coll
		Set t_coll = Me
		'''本函数仅针对arr
		If Kind <> 1 Then
			Exit Function
		End If
		If t_coll.Count = 0 Then
			Exit Function
		End If
		Dim i,j,o,currentData,parentData,pchildren
		Dim targetData
		'Set targetData = CreateObject("Scripting.Dictionary")
		Set targetData = new JsonClass
		targetData.Kind = 1
		Dim records
		Set records = new JsonClass
		records.Kind = 0
		Dim itemLength : itemLength = t_coll.Count
		For i = 0 To (itemLength-1)
			For Each j In t_coll(i).Collection
				'Response.Write(t_coll(i).Collection.Item(j))
				'Response.Write(j & "--")
				'Call records.Add(Cstr(j), Cstr(t_coll(i).Collection.Item(j)))
				records(j) = t_coll(i).Collection.Item(j)
			Next
		Next
		Response.Charset = "UTF-8"
		Response.ContentType = "application/json"
		Easp.noCache_()
		Easp.WE ToJson(records)
		Response.End
		'Exit Sub
		For i = 0 To (itemLength-1)
			'currentData = t_coll(i).Collection.Items
			Set currentData = t_coll(i)
			Set parentData = new JsonClass
			parentData.Kind = 1
			response.write(currentData(p_pid))
			If records.Exists(currentData(p_pid)) = False Then
				'Set targetData(i) = currentData
				targetData(Null) = currentData
				response.Write("靠")
			Else
				response.Write("擦")
				Set parentData = records(currentData(p_pid))
				If parentData.Exists(p_sign) Then
					Set pchildren = parentData(p_sign)
				Else
					Set pchildren = new JsonClass
					pchildren.Kind = 0
				End If
				Set pchildren(p_sign) = currentData
			End If
		Next
		'Set Collection = targetData.Collection
		'Set Me = targetData
		'Response.Clear()
		Response.Charset = "UTF-8"
		Response.ContentType = "application/json"
		Easp.noCache_()
		Easp.WE ToJson(targetData)
	End Function
End Class
%>